START Magazine/START VOL 4 NO 7.st/AIDOCTOR.ARC/AIDOCTOR.LST

File List | 1989-11-09 | 26.0 KB | 909 lines

' #############################################################################
' #############################################################################
' ######################## A.I. DOCTOR BY RON SCHAEFER MD #####################
' ################### COPYRIGHT 1990 by ANTIC PUBLISHING INC. #################
' #############################################################################
' #############################################################################
Clear
Defnum 5
Path$=Dir$(0)+"\"             !define directory as one program was started in
R%=Xbios(4)                    !test for rez
If R%=0 Then
  Alert 3,"Sorry, the A.I. Doctor works|only in High and Medium|resolutions.",1," OK ",Dummy
  End
Endif
If R%=1 Then                   !medium resolution
  If Not Exist(Path$+"aidoctor.pi2") Then
    Alert 3,"The file AIDOCTOR.PI2 must be|in the same folder as|AIDOCTOR.PRG",1," OK ",Dummy
    End
  Endif
  Picname$=Path$+"aidoctor.pi2"         !name of title screen degas picture
  X%=1
Else                            !only one left is high resolution
  If Not Exist(Path$+"aidoctor.pi3") Then
    Alert 3,"The file AIDOCTOR.PI3 must be|in the same folder as|AIDOCTOR.PRG",1," OK ",Dummy
    End
  Endif
  X%=2
  F%=7
  Picname$=Path$+"aidoctor.pi3"       !hi rez title screen picture
Endif
Dim Mstrip$(50),Cad$(2)
Dim Spalette%(16,3)
Dim Rule$(200,2)
Num_dim=200
On Break Gosub Cleanup
@Make_sprite                   !make a sprite for dialog box
@Save_pal                      !save the current palette
@Degas                         !display the degas picture
' ------------------------------ READ MENU STRIP DATA --------------------------
Restore Strip_data
For I%=0 To 15
  Read Mstrip$(I%)
Next I%
' ----------------------------- PROGRAM CONTROL LOOP ---------------------------
Menu Mstrip$()
Menu 12,2
Sget Title$                       !save picture screen
@Disclaim                         !disclaimer dialog box
Sput Title$                       !display saved screen
On Menu  Gosub Menu_handler
On Menu Key Gosub Menu_handler
Do
  On Menu
  Exit If All_done!
Loop
@Restorepal                        !restore palette to original colors
Edit
' ----------------------------- END PROGRAM LOOP -------------------------------
Procedure Menu_handler
  If Mstrip$(Menu(0))="  QUIT      Q " Or Menu(14)=4096
    Menu Off
    Alert 3,"|Do you really want to quit?",1," QUIT | STAY ",Qs
    @Ds_2(5,5)             !sound routine for clicking noise
    If Qs=1 Then
      @Closing_box
      @Cleanup
    Endif
  Endif
  If Mstrip$(Menu(0))="  About The Doctor "         !about dialog box
    @Ds_2(5,5)
    Openw 0
    @About_doctor
    @Ds_2(5,5)
    Graphmode 1
    Closew 0
    Menu Off
    Sput Title$
  Endif
  If Mstrip$(Menu(0))="  Load File L " Or Menu(14)=9728
    Menu Off                     !menu(14)=9728 tests for a alternate L
    @Ds_2(5,5)
    @R_data
    Sput Title$
    @Ds_1(4,4)
    Pause 4
    @Ds_1(6,4)
    Pause 4
    @Ds_1(5,4)
    Pause 4
  Endif
  If Mstrip$(Menu(0))="  Diagnosis D " Or Menu(14)=8192
    @Do_dx
    Menu 13,2                        !kludgey bug fix
    Menu Off
    Sput Title$
  Endif
  If Mstrip$(Menu(0))="  HELP " Or Menu(14)=25088
    @Do_help
    Menu Off
    Sput Title$
    If Pushed=2 Then
      @Disclaim
      Menu Off
      Sput Title$
    Endif
  Endif
Return
' ------------------------- DO THE DIAGNOSIS -----------------------
Procedure Do_dx
  ' ------------------- DEFFINITIONS OF VARIABLES ------------------
  ' Rule$()= text for rules or symptoms
  ' Illness$()=  name of illnesses
  ' Il()=  element of relavent (il_cnt,il_sub,1-3) sx, yes prob, no prob
  ' Il_sub()=  number of elements per illness
  ' Il_p()= prior prob of an illness
  ' cnt_rl = number of rules  cnt_il% = number of illnesses
  ' P(Cnt_il%)= current probability
  ' Rv(Cnt_rl%)= value of each symptom in terms of amount of change p illness
  ' Relevant_sx(Cnt_il%)= list of symptoms still to be asked
  ' Minimum(Cnt_il%)= minimum possibile value which each illness can achieve
  ' Maximum(Cnt_il%)= maximum possibile value which each illness can achieve
  ' Flag(Cnt_rl%)= flag to prevent each question from being asked twice
  '
  Erase P()            ! current probability
  Erase Rv()    ! value of each symptom in terms of amount of change p illness
  Erase Relevant_sx()  ! list of symptoms still to be asked
  Erase Minimum()      ! minimum possible value which each illness can achieve
  Erase Maximum()      ! maximum possible value which each illness can achieve
  Erase Flag()         ! flag to prevent each question from being asked twice
  Erase Bp()           ! bubble sort current probabities
  Dim P(Cnt_il%),Rv(Cnt_rl%),Relevant_sx(Cnt_il%),Maximum(Cnt_il%),Minimum(Cnt_il%),Flag(Cnt_rl%)
  Dim Bp(Cnt_il%)
  ' --------------------------------------------------------------------------
  ' Example of input
  ' Acute Hepatitis  = Illness$()
  ' .001,     8,      .8,   .01,    15,.8,.01,17,.5,.01,42,.5,.01,45,.5,.01,41,.5,.01,999
  ' il_p(),Il(x,y,1),Il(x,y,2),Il(x,y,3)
  ' ---------------------------------------------------------------------------
  Arrayfill Flag(),1
  For N%=1 To Cnt_il%
    P(N%)=Il_p(N%)
  Next N%
  Titlew 1,"  Diagnosis  "             !title for window
  Fullw 1
  Openw 1
  Clearw 1
  Defmouse 2                               !change mouse shape
  For I%=1 To Cnt_il%        !calcuate prior probabilities and the rule values
    P=P(I%)
    For K%=1 To Il_sub(I%)
      Inc Relevant_sx(I%)
      Add Rv(Il(I%,K%,1)),Abs(P*Il(I%,K%,2)/(P*Il(I%,K%,2)+(1-P)*Il(I%,K%,3))-P*(1-Il(I%,K%,2))/(P*(1-Il(I%,K%,2))+(1-P)*(1-Il(I%,K%,3))))
    Next K%
  Next I%
  Another:
  R=0
  Hr=0
  For I%=1 To Cnt_rl%
    If Rv(I%)>R Then               !determine the best question to ask
      '      Print R,Rv(I%),"best question hr=i%=";I%
      R=Rv(I%)
      Hr=I%
    Endif
    Rv(I%)=0
  Next I%
  ' ---------------------- List top four diagnoses at this point ----------
  For I%=1 To Cnt_il%
    Bp(I%)=P(I%)
    Bil$(I%)=Illness$(I%)
  Next I%
  N=Cnt_il%
  For L%=1 To N-(N-4)        ! n-x gives top x numbers
    For I%=1 To N-1
      For J%=I% To I%
        If Bp(J%)>Bp(J%+1) Then
          Swap Bp(J%),Bp(J%+1)
          Swap Bil$(J%),Bil$(J%+1)
        Endif
      Next J%
    Next I%
  Next L%
  Print At(10,1);"The top four most likely diagnoses at this time are"
  For I%=N To N-3 Step -1
    Print Space$(21);Bil$(I%);" with a probability =";Int(Bp(I%)*100);"%"
  Next I%
  ' --------------------------------------------------------------------
  Defmouse 0
  @Dialog(Hr)           !ask the symptom using the symptom dialog box
  Defmouse 2
  If Pushed=-10 Then    !if exit pushed end calculations
    Goto Endit
  Endif
  Flag(Hr)=0
  For I%=1 To Cnt_il%
    For K%=1 To Il_sub(I%)
      If Il(I%,K%,1)<>Hr Or Relevant_sx(I%)=0 Then
        Goto Skip
      Endif
      Dec Relevant_sx(I%)
      P=P(I%)
      Pe=P*Il(I%,K%,2)+(1-P)*Il(I%,K%,3)
      ' ------ determine degree of certainty by dividing PUSHED by 5
      If Pushed>0 Then
        P(I%)=P*(1+(Il(I%,K%,2)/Pe-1)*Pushed/5)
      Endif
      If Pushed<=0 Then
        P(I%)=P*(1+(Il(I%,K%,2)-(1-Il(I%,K%,2))*Pe/(1-Pe))*Pushed/5)
      Endif
      If P(I%)=Int(P(I%)) Then
        Relevant_sx(I%)=0  !definite event no more questions need be asked about this illness
      Endif
      Skip:
    Next K%
  Next I%
  Current_max=0
  Current_max_i=0
  For I%=1 To Cnt_il%
    P_yy=1
    P_yn=1
    P_ny=1
    P_nn=1
    P=P(I%)
    For K%=1 To Il_sub(I%)       !determine new minimum and max probabilities
      If Flag(Il(I%,K%,1))*Relevant_sx(I%)=0 Then
        Goto Skipped
      Endif
      If Il(I%,K%,3)>Il(I%,K%,2) Then
        Il(I%,K%,2)=1-Il(I%,K%,2)
        Il(I%,K%,3)=1-Il(I%,K%,3)
      Endif
      Add Rv(Il(I%,K%,1)),P*Il(I%,K%,2)/(P*Il(I%,K%,2)+(1-P)*Il(I%,K%,3))-P*(1-Il(I%,K%,2))/(P*(1-Il(I%,K%,2))+(1-P)*(1-Il(I%,K%,3)))
      Mul P_yy,Il(I%,K%,2)
      Mul P_yn,Il(I%,K%,3)
      Mul P_ny,(1-Il(I%,K%,2))
      Mul P_nn,(1-Il(I%,K%,3))
      Skipped:
    Next K%
    Maximum(I%)=P*P_yy/(P*P_yy+(1-P)*P_yn)
    Minimum(I%)=P*P_ny/(P*P_ny+(1-P)*P_nn)
    If Maximum(I%)<Il_p(I%) Then
      Relevant_sx(I%)=0
    Endif
    If Minimum(I%)>Current_max Then
      Current_max_i=I%
      Current_max=Minimum(I%)
    Endif
  Next I%
  Max_prob=0
  Max_prob_i=0
  For I%=1 To Cnt_il%
    If P(I%)>Max_prob Then        !find the highest probability
      Max_prob_i=I%
      Max_prob=P(I%)
    Endif
  Next I%
  If Max_prob<0.98 Then             !test to threshhold of probability 98%
    Goto Another
  Endif
  Alert 3,"The best diagnosis is|"+Illness$(Max_prob_i)+"|probability of "+Str$(Int(P(Max_prob_i)*100))+"%",1," wow ",Junk
  Endit:
  @Bubble_sort
  Closew 1
Return
' ----------------------- BUBBLE SORT ---------------------------
Procedure Bubble_sort
  For I%=1 To Cnt_il%
    Bp(I%)=P(I%)
    Bil$(I%)=Illness$(I%)
  Next I%
  N=Cnt_il%
  For L%=1 To N-(N-20)        ! n-x gives top numbers
    For I%=1 To N-1
      For J%=I% To I%
        If Bp(J%)>Bp(J%+1) Then
          Swap Bp(J%),Bp(J%+1)
          Swap Bil$(J%),Bil$(J%+1)
        Endif
      Next J%
    Next I%
  Next L%
  Clearw 1
  Deftext 3
  Print At(25,1);"--> LIST OF THE TOP 20 DIAGNOSES <--"
  Deftext 1
  Incre%=0
  For I%=N To N-19 Step -1
    Inc Incre%
    Print At(1,1+Incre%);"      ";Incre%;") ";Bil$(I%);" with a probability of "
    Print At(57,1+Incre%);Bp(I%)
  Next I%
  Defmouse 0
  Do
    Exit If Inkey$<>"" Or Mousek>0
  Loop
Return
' ---------------------------------------------------------------------
Procedure Cleanup
  @Restorepal
  Erase Rule$()          ! rules or symptoms
  Erase Illness$()       ! illnesses
  Erase Il()             ! element of relavent sx, yes prob, no prob
  Erase Il_sub()         ! number of elements per illness
  Erase Il_p()           ! prior prob of an illness
  Menu 12,3
  Edit
Return
' -----------------------------------------------------------------------
Procedure About_doctor
  I=0
  Inc Modinc
  Deffill 0,2,8
  Pbox 74,39*R%,575,177*R%
  @About_text
  Graphmode 3
  Do                              !create graphics for dialog box
    Mouse Mx,My,Clk
    Exit If (Clk>0 And Mx>172 And Mx<244 And My>153*R% And My<165*R%) Or Inkey$<>""
    Box (I Mod 200)+359,((I Mod 123)+47)*R%,(199-I Mod 200)+359,((122-I Mod 123)+47)*R%
    Add I,Modinc
    Showm
    Pause 1
  Loop
  Pbox 172,153*R%,244,165*R%
  Pause 5
  Mx=0
  My=0
Return
' ---------------------------------------------------------------------
Procedure About_text
  Graphmode 1
  Color 1
  Box 78,42*R%,569,174*R%
  Box 74,39*R%,575,177*R%
  Box 358,46*R%,559,170*R%
  Box 169,151*R%,246,167*R%
  Box 172,153*R%,244,165*R%
  Deftext 1,0,0,6+F%
  Text 185,162*R%,"CANCEL"
  Graphmode 2
  If R%=1 Then
    Deftext 3,0,0,32
    Text 109,74," A.I. DOCTOR"
  Endif
  Deftext 2,0,0,32
  Text 108,75*R%," A.I. DOCTOR"
  Graphmode 1
  Deftext 1,4,0,6+F%
  Text 130,90*R%,"by Ron Schaefer M.D."
  Deftext 1,0,0,6+F%
  Text 90,99*R%,"(C) 1990 Antic Publishing, Inc."
  Text 130,108*R%,"All Rights Reserved"
  Text 130,120*R%,"Written in GFA BASIC 2.0"
  Text 130,129*R%," "
  Text 130,144*R%,"Free Memory "+Str$(Fre(0))
  Sprite Cad$(1),95,66*R%
  Sprite Cad$(2),310,66*R%
Return
' ------------- SAVE ORIGINAL COLOR PALETTE -----------------------
Procedure Save_pal
  For Z%=0 To 15
    Dpoke Contrl,26
    Dpoke Contrl+2,0
    Dpoke Contrl+6,2
    Dpoke Intin,Z%
    Dpoke Intin+2,0
    Vdisys
    Spalette%(Z%,0)=Dpeek(Intout+2)
    Spalette%(Z%,1)=Dpeek(Intout+4)
    Spalette%(Z%,2)=Dpeek(Intout+6)
  Next Z%
Return
Procedure Restorepal
  ' --------------------- RESTORES PALETTE -------------------
  For Z%=0 To 15
    Dpoke Contrl,14
    Dpoke Contrl+2,0
    Dpoke Contrl+6,4
    Dpoke Intin,Z%
    Dpoke Intin+2,Spalette%(Z%,0)
    Dpoke Intin+4,Spalette%(Z%,1)
    Dpoke Intin+6,Spalette%(Z%,2)
    Vdisys
  Next Z%
Return
' ---------------------------------------------------------------------
Procedure Set_colors
  Setcolor 0,0,0,0
  Setcolor 3,7,7,7
  Setcolor 2,0,4,7
Return
' ---------------------------------------------------------------------------
Procedure Make_sprite
  ' Sprite-Convert data in string
  For N%=1 To 2
    Let Cad$(N%)=Mki$(0)+Mki$(0)
    Let Cad$(N%)=Cad$(N%)+Mki$(0)
    Let Cad$(N%)=Cad$(N%)+Mki$(0)
    Let Cad$(N%)=Cad$(N%)+Mki$(3)
    Restore Sprite_data
    For I%=1 To 16
      Read Foregrnd,Backgrnd
      Let Cad$(N%)=Cad$(N%)+Mki$(Backgrnd)+Mki$(Foregrnd)
    Next I%
  Next N%
Return
' ----------------------------- SOUND ROUTINES ---------------------------
Procedure Ds_1(Snd,Snd1)
  Sound 1,12,Snd,Snd1
  Wave 1,1,9,6000
Return
Procedure Ds_2(Snd,Snd1)
  Sound 1,12,Snd,Snd1
  Wave 1,1,8,512,5
  Wave 0,0
Return
Procedure Ds_3(Snd,Snd1,Per,Dur)
  Sound 1,2,Snd,Snd1
  Wave 1,1,9,Per,Dur
Return
' ------------------------- READ IN RX DATA ---------------------------------
Procedure R_data
  Erase Rule$()          ! rules or symptoms
  Erase Illness$()       ! illnesses
  Erase Bil$()           ! bubble sort illnesses
  Erase Il()             ! element of relavent sx, yes prob, no prob
  Erase Il_sub()         ! number of elements per illness
  Erase Il_p()           ! prior prob of an illness
  Dim Rule$(Num_dim,2),Illness$(Num_dim),Il(Num_dim,20,3),Il_sub(Num_dim),Il_p(Num_dim)
  Dim Bil$(Num_dim)
  Do
    Fileselect Path$+"*.DAT","RX.DAT",Rx.dat$
    Exit If Rx.dat$="" Or Rx.dat$<>" "
  Loop
  @Ds_2(5,5)
  If Rx.dat$<>"" Then
    If Exist(Rx.dat$) Then
      Alert 1,"Do you want to list out|the data as it is|read into memory?",3,"Fast|Paging|No",Pk
      If Pk<>3 Then
        Titlew 1,"  Reading the Knowledge Base Rules  "
        Fullw 1
        Openw 1
        Clearw 1
        Print At(1,1);
      Endif
      Open "I",#1,Rx.dat$
      Cnt_rl%=1
      '                ****  READ IN THE SYMPTOMS ****
      Defmouse 2
      Do
        Input #1,A
        If A<>Cnt_rl% And A<>999999999 Then
          Alert 2,"THE QUESTION NUMBERS ARE|OUT OF ORDER.",1," OK | ABORT ",Pk
          If Pk=2 Then
            Goto Abort_read
          Else
            Cnt_rl%=A
          Endif
          Defmouse 2
        Endif
        Exit If A=999999999
        Line Input #1,Rule$(A,1)
        Line Input #1,X$
        If X$<>"." Then
          Rule$(A,2)=X$
        Endif
        Inc Cnt_rl%
      Loop
      If Pk=1 Or Pk=2 Then     ! Print out symptoms
        @Print_sx
      Endif
      '                       ****  READ IN THE ILLNESSES ****
      Cnt_il%=1
      Do
        Input #1,A$
        Exit If A$="THE END"
        Illness$(Cnt_il%)=A$                ! read in illness
        Input #1,Il_p(Cnt_il%)         ! read in illness prior probability
        Cnt_il_sub=0
        Do
          Input #1,A
          Exit If A=999
          Input #1,B
          Input #1,C
          Inc Cnt_il_sub
          Il(Cnt_il%,Cnt_il_sub,1)=A
          Il(Cnt_il%,Cnt_il_sub,2)=B
          Il(Cnt_il%,Cnt_il_sub,3)=C
        Loop
        Il_sub(Cnt_il%)=Cnt_il_sub
        Inc Cnt_il%
      Loop
      Dec Cnt_il%
      If Pk=1 Or Pk=2 Then         ! Print out illnesses
        @Print_il
      Endif
      Menu 12,3                    ! Turn on "Diagnosis" option
      Abort_read:
      Close #1
      Closew 1
      File_ok!=True
    Else
      Alert 1,"Sorry the file|"+Rx.dat$+"|was not found",1," OK ",Junk
    Endif
  Endif
  Defmouse 0
Return
' ---------------------------- PRINT SYMPTOMS TO SCREEN -----------------
Procedure Print_sx
  Line=0
  Print At(1,1);
  Defmouse 0
  For N=1 To Cnt_rl%-1
    Print N;") ";Rule$(N,1)
    Print "    ";Rule$(N,2)
    Add Line,2
    If Line>18 Then
      If Pk=2 Then
        Do
          Exit If Inkey$<>"" Or Mousek>0
        Loop
        @Ds_2(5,4)
      Endif
      Clearw 1
      Line=0
      Print At(1,1);
    Endif
  Next N
  Defmouse 2
Return
' ----------------------- PRINT ILLNESSES TO SCREEN --------------------
Procedure Print_il
  Defmouse 0
  Clearw 1
  Print At(1,1);
  Line=0
  For N=1 To Cnt_il%-1
    Print N;") ";Illness$(N);"  ";Il_p(N)
    Inc Line
    For M=1 To Il_sub(N)
      Print Il(N,M,1),Il(N,M,2),Il(N,M,3)
      Inc Line
      If Line>19 Then
        If Pk=2 Then
          Do
            Exit If Inkey$<>"" Or Mousek>0
          Loop
          @Ds_2(5,4)
        Endif
        Clearw 1
        Line=0
        Print At(1,1);
      Endif
    Next M
  Next N
Return
' -------------------------- SYMPTOM DIALOG BOX ---------------------------
Procedure Dialog(Xx)
  Gmx=314
  Gmy=106*R%
  Ex=38
  Ey=65*R%
  Ew=562
  Eh=92*R%
  @Grow_shrink_box(1)
  Deffill 0,2,8
  Pbox 34,43*R%,604,139*R%
  Box 34,43*R%,604,139*R%
  Deffill 2,2,7
  Pbox 38,45*R%,600,137*R%
  Box 38,45*R%,600,137*R%
  Deffill 0,2,8
  Pbox 50,50*R%,590,92*R%
  Box 50,50*R%,590,92*R%
  Pbox 53,96*R%,182,113*R%
  Box 53,96*R%,182,113*R%
  Pbox 57,98*R%,178,111*R%
  Box 57,98*R%,178,111*R%
  Pbox 53,116*R%,182,133*R%
  Box 53,116*R%,182,133*R%
  Pbox 57,118*R%,178,131*R%
  Box 57,118*R%,178,131*R%
  Pbox 445,96*R%,588,113*R%
  Box 445,96*R%,588,113*R%
  Pbox 449,98*R%,584,111*R%
  Box 449,98*R%,584,111*R%
  Pbox 445,116*R%,588,133*R%
  Box 445,116*R%,588,133*R%
  Pbox 449,118*R%,584,131*R%
  Box 449,118*R%,584,131*R%
  Pbox 239,96*R%,387,113*R%
  Box 239,96*R%,387,113*R%
  Pbox 243,98*R%,383,111*R%
  Box 243,98*R%,383,111*R%
  Pbox 239,116*R%,387,133*R%
  Box 239,116*R%,387,133*R%
  Pbox 243,118*R%,383,131*R%
  Box 243,118*R%,383,131*R%
  Graphmode 2
  Deftext 1,0,0,6+F%
  Text 102,108*R%,"YES"
  Text 89,128*R%,"SORT OF"
  Text 480,108*R%,"NOT REALLY"
  Text 511,128*R%,"NO"
  Text 273,108*R%,"DON'T KNOW"
  ' --
  Deftext 1,0,0,4
  Text 164,108*R%,"4"
  Text 164,128*R%,"1"
  Text 575,108*R%,"6"
  Text 575,128*R%,"3"
  Text 372,108*R%,"5"
  Text 372,128*R%,"2"
  ' --
  Deftext 1,1,0,8
  Text 286,129*R%,"ABORT"
  Deftext 1,0,0,6+F%
  If Xx<>0 Then
    Text 256,60*R%,"Question # "+Str$(Xx)
    Text 80,73*R%,Rule$(Xx,1)
    Text 80,83*R%,Rule$(Xx,2)
  Else
    Text 80,73*R%,"A.I. Doctor has asked all its questions."
    Text 80,83*R%,"Press ABORT to get a list of the top 20 diagnoses."
  Endif
  Graphmode 1
  ' ----------------------------- TEST FOR BUTTONS --------------------
  Button_pushed!=False
  Deffill 1,2,8
  Do
    Mouse Mx,My,Clk
    A$=Inkey$
    Exit If Button_pushed!
    If (Clk>0 And Mx>53 And Mx<182 And My>96*R% And My<113*R%) Or A$="4"
      @Ds
      Pushed=3
      Button_pushed!=True
      Graphmode 3
      Pbox 53,96*R%,182,113*R%
      Pause 10
      Graphmode 1
    Endif
    If (Clk>0 And Mx>53 And Mx<182 And My>116*R% And My<133*R%) Or A$="1"
      @Ds
      Pushed=1
      Button_pushed!=True
      Graphmode 3
      Pbox 53,116*R%,182,133*R%
      Pause 10
      Graphmode 1
    Endif
    If (Clk>0 And Mx>239 And Mx<387 And My>96*R% And My<113*R%) Or A$="5"
      @Ds
      Pushed=0
      Button_pushed!=True
      Graphmode 3
      Pbox 239,96*R%,387,113*R%
      Pause 10
      Graphmode 1
    Endif
    If (Clk>0 And Mx>239 And Mx<387 And My>116*R% And My<133*R%) Or A$="2"
      @Ds
      Pushed=-10
      Button_pushed!=True
      Graphmode 3
      Pbox 239,116*R%,387,133*R%
      Pause 10
      Graphmode 1
    Endif
    If (Clk>0 And Mx>445 And Mx<588 And My>96*R% And My<113*R%) Or A$="6"
      @Ds
      Pushed=-1
      Button_pushed!=True
      Graphmode 3
      Pbox 445,96*R%,588,113*R%
      Pause 10
      Graphmode 1
    Endif
    If (Clk>0 And Mx>445 And Mx<588 And My>116*R% And My<133*R%) Or A$="3"
      @Ds
      Pushed=-3
      Button_pushed!=True
      Graphmode 3
      Pbox 445,116*R%,588,133*R%
      Pause 10
      Graphmode 1
    Endif
  Loop
  Cls
  @Grow_shrink_box(2)
Return
' ------------------------------- CLICK SOUND -----------------------
Procedure Ds
  Sound 1,12,5,5
  Wave 1,1,8,512,5
  Wave 0,0
Return
' ------------------------------ GROW/SHRINK BOX ----------------------------------
Procedure Grow_shrink_box(M)
  Dpoke Gintin,Gmx
  Dpoke Gintin+2,Gmy
  Dpoke Gintin+4,10
  Dpoke Gintin+6,10
  Dpoke Gintin+8,Ex
  Dpoke Gintin+10,Ey
  Dpoke Gintin+12,Ew
  Dpoke Gintin+14,Eh
  If M=1 Then
    Gemsys (73)
  Else
    Gemsys (74)
  Endif
Return
' --------------------------- END OF PROGRAM GRAPHICS --------------------
Procedure Closing_box
  Openw 0
  X=0
  Y=0
  X1=640
  Y1=199*R%
  Ds=12
  Dss=8
  Color 0
  Do
    @Ds_1(Ds,Dss)
    Dec Dss
    If Dss=0 Then
      Dec Ds
      Dss=8
    Endif
    Color N
    Inc N
    If N>3 Then
      N=0
    Endif
    Box X,Y,X1,Y1
    Dec X1
    Inc X
    If Even(X) Then
      Dec Y1
      Inc Y
    Endif
    Exit If Y=100*R%
  Loop
  Menu Kill
  All_done!=True
Return
' ========================== LOAD DEGAS FILE ===========================
Procedure Degas
  If Exist(Picname$) Then
    Cls
    Open "I",#1,Picname$
    Temp$=Input$(36,#1)
    Colr$=Mid$(Temp$,3,36)
    Close #1
    Void Xbios(6,L:Varptr(Colr$))
    Physbase=Xbios(2)
    Bload Picname$,Physbase-34
  Else
    Print "picture file not found"
    K=Inp(2)
  Endif
Return
' --------------------------- DISCLAIMER DIALOG BOX --------------------
Procedure Disclaim
  Gmx=314
  Gmy=97*R%
  Ex=21
  Ey=38*R%
  Ew=596
  Eh=128*R%
  @Grow_shrink_box(1)
  Deffill 0,2,8
  Pbox 17,36*R%,621,168*R%
  Box 17,36*R%,621,168*R%
  Deffill 2,2,8
  Pbox 21,38*R%,617,166*R%
  Box 21,38*R%,617,166*R%
  Deffill 1,2,8
  Pbox 33,44*R%,605,132*R%
  Box 33,44*R%,605,132*R%
  Deffill 0,2,8
  Pbox 265,143*R%,372,159*R%
  Box 265,143*R%,372,159*R%
  Deffill 1,2,8
  Pbox 269,145*R%,368,157*R%
  Box 269,145*R%,368,157*R%
  Graphmode 2
  Deftext 0,0,0,8
  Text 309,155*R%,"OK"
  Deftext 0,0,0,6+F%
  Text 72,56*R%,"                       The A.I. Doctor"
  Text 72,68*R%,"       This program is intended to be an example of artificial"
  Text 72,76*R%,"intelligence and not a substitute for a physician.  If you are"
  Text 72,84*R%,"sick you should see a real doctor, not an artificial one!"
  Text 72,94*R%,"    This inference engine uses the Bayes' Theorem to calculate"
  Text 72,102*R%,"the most likely diagnosis based on a limited knowledge base of"
  Text 72,110*R%,"69  symptoms  and  89 diseases.    You can also make your own"
  Text 72,118*R%,"knowledge bases about whatever topic you want."
  Graphmode 1
  ' ----------------------------- TEST FOR BUTTONS --------------------
  Button_pushed!=False
  Deffill 1,2,8
  Do
    Mouse Mx,My,Clk
    A$=Inkey$
    Exit If Button_pushed!
    If (Clk>0 And Mx>265 And Mx<372 And My>143*R% And My<159*R% Or Asc(A$)=13) Then
      @Ds
      Pushed=1
      Button_pushed!=True
      Graphmode 3
      Pbox 265,143*R%,372,159*R%
      Pause 10
      Graphmode 1
    Endif
  Loop
  Deftext 1,0,0,6+F%
  @Grow_shrink_box(2)
Return
' ---------------------------- HELP DIALOG BOX ---------------------------
Procedure Do_help
  Gmx=328
  Gmy=96.5*X%
  Ex=75
  Ey=23*X%
  Ew=516
  Eh=157*X%
  @Grow_shrink_box(1)
  Deffill 0,2,8
  Pbox 71,21*X%,595,182*X%
  Box 71,21*X%,595,182*X%
  Deffill 2,2,8
  Pbox 75,23*X%,591,180*X%
  Box 75,23*X%,591,180*X%
  Deffill 0,2,8
  Pbox 280,162*X%,402,177*X%
  Box 280,162*X%,402,177*X%
  Deffill 1,2,8
  Pbox 85,50*X%,581,155      ! New box
  Pbox 284,164*X%,398,175*X%
  Box 284,164*X%,398,175*X%
  Deffill 0,2,8
  Pbox 440,162*X%,564,177*X%
  Box 440,162*X%,564,177*X%
  Deffill 1,2,8
  Pbox 444,164*X%,560,175*X%
  Box 444,164*X%,560,175*X%
  Graphmode 2
  Deftext 0,4,0,12+F%
  Text 297,43*X%,"HELP !"
  Deftext 1,4,0,12+F%
  Text 294,44*X%,"HELP !"
  Deftext 0,0,0,6+F%
  Graphmode 2
  Text 94,62*X%,"     To  use the A.I. Doctor, first open a knowledge base."
  Text 94,70*X%,"The one supplied with the program is called 'RX.DAT' and is"
  Text 94,78*X%,"loaded into memory by selecting the dropdown menu item LOAD"
  Text 94,86*X%,"and clicking on this file.  Once loaded into memory you will"
  Text 94,94*X%,"hear  a three-tone beep.   You can now select the dropdown"
  Text 94,102*X%,"menu  item  Diagnosis.   You  will  be  asked  a  series  of"
  Text 94,110*X%,"questions about symptoms.   Click on the appropriate answer."
  Text 94,118*X%,"You  can also select your answer using the number  key  pad,"
  Text 94,126*X%,"the  small number on each button corresponds to the key  pad"
  Text 94,134*X%,"number.   You keep answering questions until a diagnosis  is"
  Text 94,142*X%,"made  or until you select ABORT; then you will be  presented"
  Text 94,150*X%,"with a list of the top 20 diagnoses."
  Text 310,172*X%,"Continue"
  Text 465,172*X%,"Disclaimer"
  Graphmode 1
  ' ----------------------------- TEST FOR BUTTONS --------------------
  Button_pushed!=False
  Deffill 1,2,8
  Do
    Mouse Mx,My,Clk
    A$=Inkey$
    Exit If Button_pushed!
    If (Clk>0 And Mx>436 And Mx<586 And My>161*X% And My<178*X%) Then
      @Ds
      Pushed=2
      Button_pushed!=True
      Graphmode 3
      Pbox 440,162*X%,564,177*X%
      Pause 10
      Graphmode 1
    Endif
    If (Clk>0 And Mx>279 And Mx<403 And My>161*X% And My<178*X% Or Asc(A$)=13) Then
      @Ds
      Pushed=1
      Button_pushed!=True
      Graphmode 3
      Pbox 279,161*X%,403,178*X%
      Pause 10
      Graphmode 1
    Endif
  Loop
  Deftext 1,0,0,6
  @Grow_shrink_box(2)
Return
' ---------------------------------------------------------------------
' .............................. SPRITE DATA .............................
Sprite_data:
Data 896,0,1088,0,896,0,57614,0,16376,0,8176,0,256,0,8176,0
Data 256,0,4064,0,256,0,1984,0,256,0,896,0,256,0,0,0
' ............................... MENU STRIP DATA .............................
Strip_data:
Data THE DOCTOR ,  About The Doctor ,--------------------,-,-,-,-,-,-,""
Data OPTIONS  ,  Load File L ,  Diagnosis D ,  HELP ,----------------,  QUIT      Q ,""
Data "",""